home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 117 (1989-11-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 117 (1989-11-15)(Ossowski, Stefan)(DE)(PD).adf / PrintIt / PrintItDisplay.mod < prev    next >
Text File  |  1989-08-20  |  22KB  |  675 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                                                                         *)
  3. (*                    This handles PrintIt!'s Display                      *)
  4. (*                                                                         *)
  5. (*-------------------------------------------------------------------------*)
  6.  
  7. IMPLEMENTATION MODULE PrintItDisplay;
  8.  
  9. (*-------------------------  IMPORTs:  ------------------------------------*)
  10.  
  11. (*------  SYSTEM:  ------*)
  12. FROM SYSTEM    IMPORT ADR, ADDRESS, SHIFT, BITSET, LONGSET, CAST;
  13. FROM Arts      IMPORT TermProcedure, Terminate;
  14.  
  15. (*------  Libraries:  ------*)
  16. FROM Exec      IMPORT AllocMem, FreeMem, MemReqs, MemReqSet, Forbid, Permit;
  17. FROM Intuition IMPORT Gadget, GadgetFlags, GadgetFlagSet, boolGadget,
  18.                       ActivationFlags, ActivationFlagSet, WindowPtr,
  19.                       NewWindow, WindowFlags, WindowFlagSet, ScreenFlags,
  20.                       ScreenFlagSet, IDCMPFlags, IDCMPFlagSet, OpenWindow,
  21.                       CloseWindow, RefreshGadgets, strGadget, StringInfo,
  22.                       IntuiMessagePtr, GadgetPtr, RethinkDisplay, OpenScreen,
  23.                       CloseScreen, ScreenPtr, NewScreen, ScreenToFront,
  24.                       WBenchToFront, MakeScreen, DisplayBeep, customScreen;
  25. FROM Graphics  IMPORT SetAPen, SetBPen, SetDrMd, RastPortPtr, RectFill,
  26.                       Move, Draw, Text, jam1, jam2, ViewModes, ViewModeSet,
  27.                       BltClear, SetRGB4, ReadPixel, WritePixel, BitMap;
  28. FROM Exec      IMPORT WaitPort, GetMsg, ReplyMsg;
  29.  
  30. (*------  Standard:  ------*)
  31. FROM Strings   IMPORT Length;
  32.  
  33. (*-------------------  Variables from Definition:  --------------------------
  34.  
  35. TYPE
  36.   Gadgets = (hori1ID,hori2ID,hori3ID,hori4ID,hori5ID,hori6ID,hori7ID,hori8ID,
  37.              vert1ID,vert2ID,vert3ID,vert4ID,vert5ID,vert6ID,vert7ID,vert8ID,
  38.              PrintNormalID,PrintDoubleID,DpiH60ID,DpiH72ID,DpiH80ID,DpiH90ID,
  39.              DpiH120ID,DpiH144ID,DpiH240ID,DpiV72ID,DpiV144ID,DpiV216ID,
  40.              PositiveID,PrintItID,LoadPicID,ResetID);
  41.   TextType = ARRAY[0..79] OF CHAR;
  42.  
  43. VAR
  44.   Window: WindowPtr;
  45.   Gadgs: ARRAY Gadgets OF Gadget;
  46.   RP: RastPortPtr;
  47.   PixName: TextType;                    (* Pic's Name                 *)
  48.   StretchX: CARDINAL;                   (* horizontal Stretch-Value   *)
  49.   StretchY: CARDINAL;                   (* vertical Stretch-Value     *)
  50.   DoublePrint: BOOLEAN;                 (* Print it Twice ?           *)
  51.   Positive: BOOLEAN;                    (* Reverse or not ?           *)
  52.   xRes: Gadgets;                        (* horizontal DPI (DpiHxxID)  *)
  53.   yRes: Gadgets;                        (* vertical DPI (DpiVxxID)    *)
  54.   Screen: ScreenPtr;                    (* Screen containing Picture  *)
  55.   Shade: CARDINAL;                      (* For Color -> BW conversion *)
  56.  
  57. -----------------------  Internal needed Variables:  ----------------------*)
  58.  
  59. VAR
  60.   IDCount: Gadgets;
  61.   NuWindow: NewWindow;
  62.   i,j: CARDINAL;
  63.   NameWindow, ConvertWindow: WindowPtr;
  64.   TextGadg,OKGadg,CancelGadg: Gadget;
  65.   TextInfo: StringInfo;
  66.   ShadeGadget: ARRAY[0..15] OF Gadget;
  67.   UsePlaneGadget, ScaleGadget, ConvertGadget: Gadget;
  68.   gadget: GadgetPtr;
  69.   PlaneString: ARRAY[0..1] OF CHAR;
  70.   Msg: IntuiMessagePtr;
  71.   map: ADDRESS;
  72.   LightColors: LONGSET;
  73.   WordPtr: POINTER TO BITSET;
  74.   Color: CARDINAL;
  75.   x,y: CARDINAL;
  76.   li: LONGINT;
  77.   Scales: ARRAY[0..4],[0..15],[0..1] OF LONGCARD; (* Grey Scales      *)
  78.             (*  ^Col   ^Bit#   ^y-Position                            *)
  79.   GreyScreen: ScreenPtr;                (* Greyscale-Screen           *)
  80.   NuScreen: NewScreen;
  81.  
  82. (*----------------------  Internal Procedures:  ---------------------------*)
  83.  
  84. (*------  Set a Bool-Gadget:  ------*)
  85.  
  86. PROCEDURE SetBool(VAR Gadg: Gadget; x,y,w,h: INTEGER);
  87.  
  88. BEGIN
  89.   WITH Gadg DO
  90.     nextGadget := NIL;
  91.     leftEdge := x;  topEdge := y;
  92.     width    := w;  height  := h;
  93.     flags    := GadgetFlagSet{};
  94.     activation   := ActivationFlagSet{gadgImmediate,toggleSelect};
  95.     gadgetType   := boolGadget;
  96.     gadgetRender := NIL;
  97.     selectRender := NIL;
  98.     gadgetText   := NIL;
  99.     mutualExclude:= LONGSET{};
  100.     specialInfo  := NIL;
  101.     gadgetID := 0;
  102.     userData := NIL;
  103.   END;
  104. END SetBool;
  105.  
  106. (*------  Draw A Box:  ------*)
  107.  
  108. PROCEDURE Box(rp: RastPortPtr; x,y,X,Y: INTEGER);
  109.  
  110. BEGIN
  111.   Move(rp,x,y); Draw(rp,X,y); Draw(rp,X,Y); Draw(rp,x,Y); Draw(rp,x,y);
  112. END Box;
  113.  
  114. (*------  Type Text:  ------*)
  115.  
  116. TYPE
  117.   TypeTextType = POINTER TO ARRAY[0..999] OF CHAR;
  118.  
  119. PROCEDURE Type(rp: RastPortPtr; x,y: INTEGER; text:TypeTextType);
  120.  
  121. BEGIN
  122.   Move(rp,x,y); Text(rp,text,Length(text^));
  123. END Type;
  124.  
  125. (*-------------------------------------------------------------------------*)
  126. (*                                                                         *)
  127. (*                          Open the Screen:                               *)
  128. (*                                                                         *)
  129. (*-------------------------------------------------------------------------*)
  130.  
  131. PROCEDURE OpenPrintIt();
  132.  
  133. BEGIN
  134.  
  135. (*------  Gadgets:  ------*)
  136.  
  137.   FOR IDCount := hori1ID TO hori8ID DO
  138.     SetBool(Gadgs[IDCount],129+16*ORD(IDCount),27,15,11);
  139.   END;
  140.   FOR IDCount := vert1ID TO vert8ID DO
  141.     SetBool(Gadgs[IDCount],1+16*ORD(IDCount),43,15,11);
  142.   END;
  143.   SetBool(Gadgs[PrintNormalID], 77, 59, 79,11);
  144.   SetBool(Gadgs[PrintDoubleID],157, 59, 79,11);
  145.   FOR IDCount := DpiH60ID TO DpiH90ID DO
  146.     SetBool(Gadgs[IDCount],65+24*(ORD(IDCount)-ORD(DpiH60ID)),75,23,11);
  147.   END;
  148.   FOR IDCount := DpiH120ID TO DpiH240ID DO
  149.     SetBool(Gadgs[IDCount],161+32*(ORD(IDCount)-ORD(DpiH120ID)),75,31,11);
  150.   END;
  151.   SetBool(Gadgs[DpiV72ID  ], 65, 91, 63,11);
  152.   SetBool(Gadgs[DpiV144ID ],129, 91, 63,11);
  153.   SetBool(Gadgs[DpiV216ID ],193, 91, 63,11);
  154.   SetBool(Gadgs[PositiveID],  9, 43, 64,11);
  155.   SetBool(Gadgs[PrintItID ],  9,107,111,11);
  156.   SetBool(Gadgs[LoadPicID ],  9,119,111,11);
  157.   SetBool(Gadgs[ResetID   ],  9,131,111,11);
  158.  
  159. (*------  Link Gadgets:  ------*)
  160.  
  161.   FOR IDCount := hori1ID TO LoadPicID DO
  162.     WITH Gadgs[IDCount] DO
  163.       nextGadget := ADR(Gadgs[Gadgets(ORD(IDCount)+1)]);
  164.       gadgetID := ORD(IDCount);
  165.     END;
  166.   END;
  167.   WITH Gadgs[ResetID] DO
  168.     nextGadget := NIL;
  169.     gadgetID := ORD(ResetID)
  170.   END;
  171.  
  172. (*------  Window:  ------*)
  173.  
  174.   WITH NuWindow DO
  175.     leftEdge   := 188;  topEdge   := 71;
  176.     width      := 264;  height    := 146;
  177.     detailPen  := 0;    blockPen  := 1;
  178.     idcmpFlags := IDCMPFlagSet{gadgetDown,closeWindow};
  179.     flags      := WindowFlagSet{windowDrag,windowDepth,windowClose,activate,
  180.                                 noCareRefresh};
  181.     firstGadget:= ADR(Gadgs);
  182.     checkMark  := NIL;
  183.     title      := ADR("Print It !");
  184.     screen     := NIL;
  185.     bitMap     := NIL;
  186.     type       := ScreenFlagSet{wbenchScreen};
  187.   END;
  188.  
  189.   Window := OpenWindow(NuWindow);
  190.   RP := Window^.rPort;
  191.  
  192. (*------  Draw into Window:  ------*)
  193.  
  194.   SetAPen(RP,2); SetDrMd(RP,jam1);
  195.   FOR i:= 128 TO 240 BY 16 DO
  196.     Box(RP,i,26,i+16,38);
  197.     Box(RP,i,42,i+16,54);
  198.   END;
  199.   Box(RP, 76, 58,236, 70); Move(RP,156,58); Draw(RP,156,70);
  200.   Box(RP,  8, 42, 73, 54);
  201.   FOR i:=64 TO 144 BY 24 DO
  202.     Box(RP,i,74,i+24,86);
  203.   END;
  204.   FOR i:= 160 TO 224 BY 32 DO
  205.     Box(RP,i,74,i+32,86);
  206.   END;
  207.   FOR i:= 64 TO 192 BY 64 DO
  208.     Box(RP,i,90,i+64,102);
  209.   END;
  210.   FOR i:= 106 TO 130 BY 12 DO
  211.     Box(RP,8,i,120,i+12);
  212.   END;
  213.   Box(RP,136,108,248,140);
  214.  
  215. (*------  Type Text into Window:  -------*)
  216.  
  217.   SetAPen(RP,1);
  218.   Type(RP,  8, 23,ADR("Pic:"));
  219.   Type(RP,  8, 35,ADR("Stretch:"));
  220.   Type(RP, 80, 35,ADR("hori:"));
  221.   Type(RP, 80, 51,ADR("vert:"));
  222.   Type(RP,132, 35,ADR("1 2 3 4 5 6 7 8"));
  223.   Type(RP,132, 51,ADR("1 2 3 4 5 6 7 8"));
  224.   Type(RP,  8, 67,ADR("Print:"));
  225.   Type(RP, 92, 67,ADR("Single    Double"));
  226.   Type(RP,  8, 92,ADR("Dpi:"));
  227.   Type(RP, 32, 83,ADR("hor:"));
  228.   Type(RP, 32, 99,ADR("ver:   72"));
  229.   Type(RP, 68, 83,ADR("60 72 80 90 120 144 240"));
  230.   Type(RP,148, 99,ADR("144     216"));
  231.   Type(RP, 24,115,ADR("Print It !"));
  232.   Type(RP, 32,127,ADR("Load Pic"));
  233.   Type(RP, 44,139,ADR("Reset"));
  234.  
  235. END OpenPrintIt;
  236.  
  237. (*-------------------------------------------------------------------------*)
  238. (*                                                                         *)
  239. (*                          Get Picture's Name                             *)
  240. (*                                                                         *)
  241. (*-------------------------------------------------------------------------*)
  242.  
  243. PROCEDURE GetName();
  244.  
  245. BEGIN
  246.  
  247. (*------  Gadgets:  ------*)
  248.  
  249.   SetBool(OKGadg    ,164, 30, 67,11);
  250.   SetBool(CancelGadg,  8, 30, 67,11);
  251.   SetBool(TextGadg  , 12, 16,216, 8);
  252.   WITH TextGadg DO
  253.     nextGadget  := ADR(OKGadg);
  254.     activation  := ActivationFlagSet{relVerify,stringCenter};
  255.     gadgetType  := strGadget;
  256.     specialInfo := ADR(TextInfo);
  257.   END;
  258.   OKGadg.nextGadget := ADR(CancelGadg);
  259.   WITH TextInfo DO
  260.     buffer := ADR(PixName);
  261.     undoBuffer := NIL;
  262.     bufferPos := 0;
  263.     maxChars := 80;
  264.     dispPos := 0;
  265.     numChars := Length(PixName);
  266.   END;
  267.  
  268. (*------  Window:  ------*)
  269.  
  270.   WITH NuWindow DO
  271.     leftEdge   := 200;  topEdge   := 105;
  272.     width      := 240;  height    := 46;
  273.     detailPen  := 0;    blockPen  := 1;
  274.     idcmpFlags := IDCMPFlagSet{gadgetDown,gadgetUp};
  275.     flags      := WindowFlagSet{windowDrag,activate,noCareRefresh};
  276.     firstGadget:= ADR(TextGadg);
  277.     checkMark  := NIL;
  278.     title      := ADR("Print It! Picture's Name:");
  279.     screen     := NIL;
  280.     bitMap     := NIL;
  281.     type       := ScreenFlagSet{wbenchScreen};
  282.   END;
  283.   NameWindow := OpenWindow(NuWindow);
  284.  
  285. (*------  Draw into Window:  ------*)
  286.  
  287.   WITH NameWindow^ DO
  288.     SetAPen(rPort,2); SetDrMd(rPort,jam1);
  289.     Move(rPort,  8, 14); Draw(rPort,232, 14); Draw(rPort,232, 26);
  290.     Draw(rPort,  8, 26); Draw(rPort,  8, 14);
  291.     Move(rPort,164, 30); Draw(rPort,232, 30); Draw(rPort,232, 42);
  292.     Draw(rPort,164, 42); Draw(rPort,164, 30);
  293.     Move(rPort,  8, 30); Draw(rPort, 76, 30); Draw(rPort, 76, 42);
  294.     Draw(rPort,  8, 42); Draw(rPort,  8, 30);
  295.     SetAPen(rPort,1);
  296.     Type(rPort,190, 39,ADR("OK"));
  297.     Type(rPort, 18, 39,ADR("Cancel"));
  298.   END;
  299.  
  300. (*------  Wait for Input:  ------*)
  301.  
  302.   WaitPort(NameWindow^.userPort);
  303.   Msg := GetMsg(NameWindow^.userPort);
  304.   gadget := Msg^.iAddress;
  305.   ReplyMsg(Msg);
  306.   CloseWindow(NameWindow);
  307.   NameWindow := NIL;
  308.   IF gadget=ADR(CancelGadg) THEN Terminate(0) END;
  309.  
  310. END GetName;
  311.  
  312. (*-------------------------------------------------------------------------*)
  313. (*                                                                         *)
  314. (*                    Set Gadgets to their values:                         *)
  315. (*                                                                         *)
  316. (*-------------------------------------------------------------------------*)
  317.  
  318. PROCEDURE InitPrintIt();
  319.  
  320. VAR
  321.   ax,ay: LONGINT; (* to draw Aspect *)
  322.  
  323. BEGIN
  324.  
  325.   RefreshGadgets(ADR(Gadgs),Window,NIL);
  326.  
  327. (*------  Set Gadgets to their values:  ------*)
  328.  
  329.   FOR IDCount := hori1ID TO ResetID DO
  330.     WITH Gadgs[IDCount] DO
  331.       flags := flags - GadgetFlagSet{selected};
  332.     END;
  333.   END;
  334.   INCL(Gadgs[Gadgets(StretchX-1)].flags,selected);
  335.   INCL(Gadgs[Gadgets(StretchY+7)].flags,selected);
  336.   IF DoublePrint THEN
  337.     INCL(Gadgs[PrintDoubleID].flags,selected);
  338.   ELSE
  339.     INCL(Gadgs[PrintNormalID].flags,selected);
  340.   END;
  341.   SetDrMd(RP,jam2); SetAPen(RP,1); SetBPen(RP,0);
  342.   IF Positive THEN
  343.     Type(RP,9,51,ADR("Positive"));
  344.   ELSE
  345.     Type(RP,9,51,ADR("Negative"));
  346.   END;
  347.   INCL(Gadgs[xRes].flags,selected);
  348.   INCL(Gadgs[yRes].flags,selected);
  349.  
  350. (*------  Type Pic's Name:  ------*)
  351.  
  352.   SetAPen(RP,0); SetDrMd(RP,jam1);
  353.   RectFill(RP,48,16,256,24);
  354.   SetAPen(RP,1);
  355.   Type(RP,48,23,ADR(PixName));
  356.  
  357. (*------  Refresh:  ------*)
  358.  
  359.   RefreshGadgets(ADR(Gadgs),Window,NIL);
  360.  
  361. (*------  Aspect:  ------*)
  362.  
  363.   SetAPen(RP,0); SetDrMd(RP,jam1);
  364.   RectFill(RP,137,109,247,139);
  365.   WITH Screen^ DO
  366.     ax := LONGINT(Screen^.width ) * LONGINT(StretchX) * 2;
  367.     ay := LONGINT(Screen^.height) * LONGINT(StretchY);
  368.   END;
  369.   CASE xRes OF
  370.     DpiH60ID:  ay := ay *  60; |
  371.     DpiH72ID:  ay := ay *  72; |
  372.     DpiH80ID:  ay := ay *  80; |
  373.     DpiH90ID:  ay := ay *  90; |
  374.     DpiH120ID: ay := ay * 120; |
  375.     DpiH144ID: ay := ay * 144; |
  376.     DpiH240ID: ay := ay * 216; |
  377.   END;
  378.   CASE yRes OF
  379.     DpiV72ID:  ax := ax *  72; |
  380.     DpiV144ID: ax := ax * 144; |
  381.     DpiV216ID: ax := ax * 216; |
  382.   END;
  383.   IF (ax * 28 DIV ay) > 108 THEN
  384.     ay := ay * 54 DIV ax;
  385.     ax := 54;
  386.   ELSE
  387.     ax := ax * 14 DIV ay;
  388.     ay := 14;
  389.   END;
  390.   SetAPen(RP,2);
  391.   RectFill(RP,192-ax,124-ay,192+ax,124+ay);
  392.   SetAPen(RP,1);
  393.   Type(RP,168,127,ADR("Aspect"));
  394.  
  395. END InitPrintIt;
  396.  
  397. (*-------------------------------------------------------------------------*)
  398. (*                                                                         *)
  399. (*               Ask to Convert Colors and do it after that:               *)
  400. (*                                                                         *)
  401. (*-------------------------------------------------------------------------*)
  402.  
  403. PROCEDURE Convert();
  404.  
  405. VAR
  406.   ColScales: ARRAY[0..63] OF CARDINAL;
  407.   B1,B2: POINTER TO LONGCARD;
  408.   NewBitMap,bm: BitMap;
  409.  
  410. BEGIN
  411.  
  412. (*------  Gadgets:  ------*)
  413.  
  414.   FOR i:=0 TO 15 DO
  415.     SetBool(ShadeGadget[i],9+i*24,25,23,11);
  416.     ShadeGadget[i].gadgetID := i;
  417.   END;
  418.   SetBool(UsePlaneGadget,  9,45,127,11);
  419.   SetBool(ScaleGadget   ,153,45, 95,11);
  420.   SetBool(ConvertGadget ,265,45,127,11);
  421.   FOR i:=0 TO 14 DO
  422.     ShadeGadget[i].nextGadget := ADR(ShadeGadget[i+1]);
  423.   END;
  424.   ShadeGadget[15].nextGadget := ADR(UsePlaneGadget);
  425.   UsePlaneGadget.nextGadget := ADR(ConvertGadget);
  426.   ConvertGadget.nextGadget := ADR(ScaleGadget);
  427.  
  428. (*------  Window:  ------*)
  429.  
  430.   WITH NuWindow DO
  431.     leftEdge   := 120;  topEdge   := 98;
  432.     width      := 400;  height    := 60;
  433.     detailPen  := 0;    blockPen  := 1;
  434.     idcmpFlags := IDCMPFlagSet{gadgetDown,gadgetUp};
  435.     flags      := WindowFlagSet{windowDrag,activate,noCareRefresh};
  436.     firstGadget:= ADR(ShadeGadget);
  437.     checkMark  := NIL;
  438.     title      := ADR("Print It !");
  439.     screen     := NIL;
  440.     bitMap     := NIL;
  441.     type       := ScreenFlagSet{wbenchScreen};
  442.   END;
  443.   ConvertWindow := OpenWindow(NuWindow);
  444.  
  445. (*------  Draw into Window:  ------*)
  446.  
  447.   WITH ConvertWindow^ DO
  448.     SetAPen(rPort,1); SetDrMd(rPort,jam1);
  449.     Type(rPort,  8,19,ADR("That's a Color Picture !"));
  450.     Type(rPort, 16,33,ADR("0  1  2  3  4  5  6  7  8  9"));
  451.     Type(rPort,252,33,ADR("10 11 12 13 14 15"));
  452.     Type(rPort, 16,53,ADR("Use Plane #       Grey Scale     Convert Pic."));
  453.     SetAPen(rPort,2);
  454.     FOR i:=8 TO 368 BY 24 DO
  455.       Box(rPort,i,24,i+24,36);
  456.     END;
  457.     Box(rPort,  8,44,136,56);
  458.     Box(rPort,152,44,248,56);
  459.     Box(rPort,264,44,392,56);
  460.     IF Shade < Screen^.bitMap.depth THEN
  461.       PlaneString[0] := CHAR(Shade+ORD("0"));
  462.     ELSE
  463.       PlaneString[0] := "0";
  464.     END;
  465.     PlaneString[1] := CHAR(0);
  466.     WITH ConvertWindow^ DO
  467.       SetDrMd(rPort,jam2); SetAPen(rPort,1); SetBPen(rPort,0);
  468.       Type(rPort,112,53,ADR(PlaneString));
  469.     END;
  470.   END;
  471.   INCL(ShadeGadget[Shade].flags,selected);
  472.   RefreshGadgets(ADR(ShadeGadget),ConvertWindow,NIL);
  473.  
  474. (*------  Wait for Input:  ------*)
  475.  
  476.   LOOP
  477.     WaitPort(ConvertWindow^.userPort);
  478.     Msg := GetMsg(ConvertWindow^.userPort);
  479.     gadget := Msg^.iAddress;
  480.     ReplyMsg(Msg);
  481.     IF     (gadget#ADR(UsePlaneGadget))
  482.        AND (gadget#ADR( ConvertGadget))
  483.        AND (gadget#ADR(   ScaleGadget)) THEN
  484.       gadget^.flags := gadget^.flags / GadgetFlagSet{selected};
  485.       RefreshGadgets(ADR(ShadeGadget),ConvertWindow,NIL);
  486.       INCL(gadget^.flags,selected);
  487.       Shade := gadget^.gadgetID;
  488.       IF Shade < Screen^.bitMap.depth THEN
  489.         PlaneString[0] := CHAR(Shade+ORD("0"));
  490.       ELSE
  491.         PlaneString[0] := "0";
  492.       END;
  493.       PlaneString[1] := CHAR(0);
  494.       WITH ConvertWindow^ DO
  495.         SetDrMd(rPort,jam2); SetAPen(rPort,1); SetBPen(rPort,0);
  496.         Type(rPort,112,53,ADR(PlaneString));
  497.       END;
  498.     ELSE
  499.  
  500.       ScreenToFront(Screen);
  501.  
  502.       WITH Screen^ DO
  503.         IF gadget=ADR(ConvertGadget) THEN
  504. (*------  Convert Pic:  ------*)
  505.           WordPtr := viewPort.colorMap^.colorTable;
  506.           LightColors := LONGSET{};
  507.           FOR i:=0 TO viewPort.colorMap^.count-1 DO
  508.             Color :=   SHIFT(CAST(CARDINAL,WordPtr^ * {8..11}),-8)
  509.                      + SHIFT(CAST(CARDINAL,WordPtr^ * {4..7} ),-4)
  510.                      + CAST(CARDINAL,WordPtr^ * {0..3});
  511.             Color := Color DIV 3;
  512.             IF Color>=Shade THEN
  513.               INCL(LightColors,i);
  514.             END;
  515.             INC(WordPtr,2);
  516.           END;
  517.           SetRGB4(ADR(viewPort),0,15,15,15); (* white *)
  518.           SetRGB4(ADR(viewPort),1, 0, 0, 0); (* black *)
  519.           SetDrMd(ADR(rastPort),jam1);
  520.           FOR y:=0 TO height-1 DO
  521.             FOR x:=0 TO width-1 DO
  522.               IF ReadPixel(ADR(rastPort),x,y) IN LightColors THEN
  523.                 SetAPen(ADR(rastPort),0);
  524.               ELSE
  525.                 SetAPen(ADR(rastPort),1);
  526.               END;
  527.               li := WritePixel(ADR(rastPort),x,y);
  528.             END;
  529.           END;
  530.           EXIT;
  531.         ELSIF gadget=ADR(ScaleGadget) THEN
  532. (*------  Produce GreyScale:  ------*)
  533.           WITH NuScreen DO
  534.             leftEdge := 0;
  535.             topEdge  := 0;
  536.             width    := 640;
  537.             height   := 16;
  538.             depth    := 1;
  539.             detailPen:= 0;
  540.             blockPen := 0;
  541.             viewModes:= ViewModeSet{hires,lace};
  542.             type     := customScreen + ScreenFlagSet{screenQuiet};
  543.             defaultTitle := NIL;
  544.             font     := NIL;
  545.             gadgets  := NIL;
  546.             customBitMap := NIL;
  547.           END;
  548.           GreyScreen := OpenScreen(NuScreen);
  549.           IF GreyScreen#NIL THEN
  550.             WITH NewBitMap DO
  551.               bytesPerRow := 2 * bitMap.bytesPerRow;
  552.               rows := 2 * bitMap.rows;
  553.               flags := bitMap.flags;
  554.               depth := 1;
  555.               planes[0] := AllocMem(LONGINT(rows) * LONGINT(bytesPerRow),MemReqSet{chip,memClear});
  556.             END;
  557.             IF NewBitMap.planes[0]=NIL THEN
  558.               CloseScreen(GreyScreen);
  559.               GreyScreen := NIL;
  560.             ELSE
  561.               bm := GreyScreen^.bitMap; GreyScreen^.bitMap := NewBitMap;
  562.               IF NewBitMap.rows>512 THEN
  563.                 GreyScreen^.height := 512;
  564.                 GreyScreen^.viewPort.dHeight := 512;
  565.               ELSE
  566.                 GreyScreen^.height := NewBitMap.rows;
  567.                 GreyScreen^.viewPort.dHeight := NewBitMap.rows;
  568.               END;
  569.               SetRGB4(ADR(GreyScreen^.viewPort),0,15,15,15); (* white *)
  570.               SetRGB4(ADR(GreyScreen^.viewPort),1, 0, 0, 0); (* black *)
  571.               MakeScreen(GreyScreen); RethinkDisplay();
  572.               FreeMem(bm.planes[0],bm.rows * bm.bytesPerRow);
  573.               WordPtr := viewPort.colorMap^.colorTable; (* Pogo! *)
  574.               FOR i:=0 TO viewPort.colorMap^.count-1 DO
  575.                 Color :=   SHIFT(CAST(CARDINAL,WordPtr^ * {8..11}),-8)
  576.                          + SHIFT(CAST(CARDINAL,WordPtr^ * {4..7} ),-4)
  577.                          + CAST(CARDINAL,WordPtr^ * {0..3});
  578.                 ColScales[i] := 4 - Color*5 DIV 48;
  579.                 INC(WordPtr,2);
  580.               END;
  581.               B1 := NewBitMap.planes[0];
  582.               B2 := B1; INC(B2,NewBitMap.bytesPerRow);
  583.               y := 0;
  584.               WHILE y<CARDINAL(height) DO
  585.                 x := 0;
  586.                 WHILE x<CARDINAL(width) DO
  587.                   FOR i:=0 TO 15 DO
  588.                     j := ColScales[ReadPixel(ADR(rastPort),x+i,y)];
  589.                     INC(B1^,Scales[j,i,0]);
  590.                     INC(B2^,Scales[j,i,1]);
  591.                   END;
  592.                   INC(B1,4);
  593.                   INC(B2,4);
  594.                   INC(x,16);
  595.                 END;
  596.                 INC(B1,NewBitMap.bytesPerRow);
  597.                 INC(B2,NewBitMap.bytesPerRow);
  598.                 INC(y);
  599.               END;
  600.               CloseScreen(Screen);
  601.               Screen := GreyScreen;
  602.               GreyScreen := NIL;
  603.               EXIT;
  604.             END;   (* IF OOM THEN *)
  605.           ELSE
  606.             DisplayBeep(NIL);
  607.             IF WBenchToFront() THEN END;
  608.           END;
  609.         ELSE
  610. (*------  Delete unwanted Planes:  ------*)
  611.           SetRGB4(ADR(viewPort),0,15,15,15); (* white *)
  612.           SetRGB4(ADR(viewPort),1, 0, 0, 0); (* black *)
  613.           IF (Shade<bitMap.depth) AND (Shade#0) THEN
  614.             map := bitMap.planes[Shade];
  615.             bitMap.planes[Shade] := bitMap.planes[0];
  616.             bitMap.planes[0] := map;
  617.           END;
  618.           i := 1;
  619.           WHILE i<bitMap.depth DO
  620.             BltClear(bitMap.planes[i],bitMap.bytesPerRow * bitMap.rows,0);
  621.             INC(i);
  622.           END;
  623.           EXIT;
  624.         END;
  625.       END;   (* WITH Screen^ DO *)
  626.     END;   (* IF gadget#Use,Convert,Scale THEN ELSE *)
  627.   END;   (* LOOP *)
  628.   RethinkDisplay();
  629.  
  630.   IF WBenchToFront() THEN END;
  631.   CloseWindow(ConvertWindow);
  632.   ConvertWindow := NIL;
  633.  
  634. END Convert;
  635.  
  636. (*------------------------------  CleanUp:  -------------------------------*)
  637.  
  638. PROCEDURE CleanUp();
  639.  
  640. BEGIN
  641.   IF NameWindow#NIL THEN CloseWindow(NameWindow) END;
  642.   IF ConvertWindow#NIL THEN CloseWindow(ConvertWindow) END;
  643.   IF GreyScreen#NIL THEN CloseScreen(GreyScreen) END;
  644. END CleanUp;
  645.  
  646. (*---------------------------  Initialization:  ---------------------------*)
  647.  
  648. BEGIN
  649.   StretchX := 1; StretchY := 1;
  650.   DoublePrint := FALSE;
  651.   xRes := DpiH240ID;
  652.   yRes := DpiV216ID;
  653.   Positive := TRUE;
  654.   NameWindow := NIL;
  655.   ConvertWindow := NIL;
  656.   PixName := "Name.iff";
  657.   Shade := 8;
  658.   GreyScreen := NIL;
  659.   TermProcedure(CleanUp);
  660. (*------  Set Up Scales:  ------*)
  661.   Scales[0,15,0] := 0; Scales[0,15,1] := 0;
  662.   Scales[1,15,0] := 1; Scales[1,15,1] := 0;
  663.   Scales[2,15,0] := 2; Scales[2,15,1] := 1;
  664.   Scales[3,15,0] := 1; Scales[3,15,1] := 3;
  665.   Scales[4,15,0] := 3; Scales[4,15,1] := 3;
  666.   i := 15;
  667.   WHILE i>0 DO
  668.     DEC(i);
  669.     FOR j:=0 TO 4 DO
  670.       Scales[j,i,0] := SHIFT(Scales[j,i+1,0],2);
  671.       Scales[j,i,1] := SHIFT(Scales[j,i+1,1],2);
  672.     END;
  673.   END;
  674. END PrintItDisplay.
  675.